home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / examples / menutree.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1991-10-06  |  8.3 KB  |  183 lines
  1. ; -*-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         menutree.lsp
  5. ; RCS:          $Header: menutree.lsp,v 1.1 91/10/05 21:29:54 mayer Exp $
  6. ; Description:  Simple menu tree program... see below
  7. ; Author:       Niels Mayer, HPLabs
  8. ; Created:      Sat Oct  5 21:24:29 1991
  9. ; Modified:     Sat Oct  5 21:29:04 1991 (Niels Mayer) mayer@hplnpm
  10. ; Language:     Lisp
  11. ; Package:      N/A
  12. ; Status:       X11r5 contrib tape release
  13. ;
  14. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. ;
  17. ; Permission to use, copy, modify, distribute, and sell this software and its
  18. ; documentation for any purpose is hereby granted without fee, provided that
  19. ; the above copyright notice appear in all copies and that both that
  20. ; copyright notice and this permission notice appear in supporting
  21. ; documentation, and that the name of Hewlett-Packard and Niels Mayer not be
  22. ; used in advertising or publicity pertaining to distribution of the software
  23. ; without specific, written prior permission.  Hewlett-Packard and Niels Mayer
  24. ; makes no representations about the suitability of this software for any
  25. ; purpose.  It is provided "as is" without express or implied warranty.
  26. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27.  
  28. ; To: davis@hplabs.hpl.hp.com (Jim Davis)
  29. ; Subject: Re: Want Menu-tree program 
  30. ; Newsgroups: comp.windows.x
  31. ; In-reply-to: Your message of 23 Aug 91 00:19:09 +0000
  32. ; Organization: Hewlett-Packard Labs, Software & Systems Lab, Palo Alto, CA.
  33. ; X-Mailer: mh6.7
  34. ; --------
  35. ; WINTERP is quite handy for building menu trees and associated actions
  36. ; without having to mess with C compiles and low-level junk. 
  37. ; 
  38. ; I have two possible solutions for you. One is the WINTERP Xmu menu server
  39. ; package that was contributed by Richard Hess of Consilium, Inc. I also
  40. ; quickly cobbled together a Winterp-Lisp file which does the basics of what
  41. ; you want.
  42. ; 
  43. ; > Where can I find such a program?  (Additional points are scored if the
  44. ; > program has a concept of string valued 'variables' that can be modified
  45. ; > through text widgets so I needn't keep using my cut buffer for such things.
  46. ; > More additional points for source, and someone to whom I can convey
  47. ; > enhancements.)
  48. ; 
  49. ; The winterp-lisp program below has this. I put a Motif text editor
  50. ; widget in there, and you can access the string in the widget by
  51. ; sending it message :GET_STRING. See code below for details.
  52. ; 
  53. ;             --------------------
  54. ;
  55. ; Here's the primitive menu tree I cobbled together. It contains a menu-bar
  56. ; with cascade-buttons "hplstl" hplhcid" "hplptd" and each cascase button has
  57. ; a pulldown with entries "xterm" "hpterm" "emacs" "xmh" "edit file in
  58. ; editor". The latter will use the value you type into the text edit widget
  59. ; in order to determine which file to edit.... 
  60. ; 
  61. ; The menubar and pulldown entries are all mnemonically driven, which means
  62. ; you don't have to use a mouse if you don't want to.
  63. ; 
  64.  
  65. (progn
  66.  
  67. (setq toplevel_w
  68.       (send TOP_LEVEL_SHELL_WIDGET_CLASS :new 
  69.         :XMN_TITLE "MenuTree"
  70.         :XMN_ICON_NAME "MenuTree"
  71.         ))
  72.  
  73. (setq rc_w
  74.       (send XM_ROW_COLUMN_WIDGET_CLASS :new :managed "rc" toplevel_w
  75.         ))
  76.  
  77. (setq menubar_w
  78.     (send XM_ROW_COLUMN_WIDGET_CLASS :new :managed :simple_menu_bar
  79.           "menubar" rc_w
  80.           :XMN_BUTTON_COUNT        3
  81.           :XMN_BUTTONS        #("hplstl" "hplhcid" "hplptd")
  82.           :XMN_BUTTON_MNEMONICS    #(#\s     #\h        #\p     )
  83.           ))
  84.  
  85. (setq edit_w
  86.       (send XM_TEXT_WIDGET_CLASS :new :managed "edit" rc_w
  87.         ))
  88.  
  89. (setq hplstl_pd_w
  90.       (send XM_ROW_COLUMN_WIDGET_CLASS :new :simple_pulldown_menu
  91.         "pulldown" menubar_w
  92.         :XMN_POST_FROM_BUTTON 0    ;post pulldown from menubar's 0th item
  93.         :XMN_BUTTON_COUNT 5        ;create five buttons in this pulldown
  94.         :XMN_BUTTONS           #("xterm" "hpterm" "emacs" "xmh" "edit file in editor")
  95.         :XMN_BUTTON_MNEMONICS       #(#\x     #\h      #\e     #\m    #\e)
  96. ;;;        :XMN_BUTTON_ACCELERATORS       #("Ctrl<Key>C" "Ctrl<Key>F" "Ctrl<Key>O" "Ctrl<Key>S" "Ctrl<Key>W")
  97. ;;;        :XMN_BUTTON_ACCELERATOR_TEXT #("^C" "^F" "^O" "^S" "^W")
  98.         )
  99.       )
  100.  
  101. (send hplstl_pd_w :add_callback :xmn_entry_callback ;use this instead of XmNsimpleCallback
  102.       '(CALLBACK_ENTRY_WIDGET)
  103.       '(
  104.     ;; (send CALLBACK_ENTRY_WIDGET :name) returns "button_<#>"
  105.     ;; where <#> is 0 ... (button-count-1).
  106.     ;; we use 'read' to return the FIXNUM <#> after truncating the
  107.     ;; 7 chars "button_" from the front of the string.
  108.     (case (read (make-string-input-stream (send CALLBACK_ENTRY_WIDGET :name) 7))
  109.           (0 (system "xhost hplstl ; remsh hplstl \"env DISPLAY=hplnpm:0.0 /usr/bin/X11/xterm \" &"))
  110.           (1 (system "xhost hplstl ; remsh hplstl \"env DISPLAY=hplnpm:0.0 /usr/bin/X11/hpterm \" &"))
  111.           (2 (system "xhost hplstl ; remsh hplstl \"env DISPLAY=hplnpm:0.0 /usr/local/bin/x11emacs \" &"))
  112.           (3 (system "xhost hplstl ; remsh hplstl \"env DISPLAY=hplnpm:0.0 /usr/local/bin/X11/xmh \" &"))
  113.           (4 (system (strcat
  114.               "xhost hplstl ; remsh hplstl \"env DISPLAY=hplnpm:0.0 /usr/local/emacs/bin300/gnuclient "
  115.               (send edit_w :get_string)
  116.               " &")))
  117.           (T (system "Error\n")))
  118.     ))
  119.  
  120. (setq hplhcid_pd_w
  121.       (send XM_ROW_COLUMN_WIDGET_CLASS :new :simple_pulldown_menu
  122.         "pulldown" menubar_w
  123.         :XMN_POST_FROM_BUTTON 1    ;post pulldown from menubar's first button.
  124.         :XMN_BUTTON_COUNT 5        ;create five buttons in this pulldown
  125.         :XMN_BUTTONS           #("xterm" "hpterm" "emacs" "xmh" "edit file in editor")
  126.         :XMN_BUTTON_MNEMONICS       #(#\x     #\h      #\e     #\m    #\e)
  127. ;;;        :XMN_BUTTON_ACCELERATORS       #("Ctrl<Key>C" "Ctrl<Key>F" "Ctrl<Key>O" "Ctrl<Key>S" "Ctrl<Key>W")
  128. ;;;        :XMN_BUTTON_ACCELERATOR_TEXT #("^C" "^F" "^O" "^S" "^W")
  129.         ))
  130.  
  131. (send hplhcid_pd_w :add_callback :xmn_entry_callback ;use this instead of XmNsimpleCallback
  132.       '(CALLBACK_ENTRY_WIDGET)
  133.       '(
  134.     ;; (send CALLBACK_ENTRY_WIDGET :name) returns "button_<#>"
  135.     ;; where <#> is 0 ... (button-count-1).
  136.     ;; we use 'read' to return the FIXNUM <#> after truncating the
  137.     ;; 7 chars "button_" from the front of the string.
  138.     (case (read (make-string-input-stream (send CALLBACK_ENTRY_WIDGET :name) 7))
  139.           (0 (system "xhost hplhcid ; remsh hplhcid \"env DISPLAY=hplnpm:0.0 /usr/bin/X11/xterm \" &"))
  140.           (1 (system "xhost hplhcid ; remsh hplhcid \"env DISPLAY=hplnpm:0.0 /usr/bin/X11/hpterm \" &"))
  141.           (2 (system "xhost hplhcid ; remsh hplhcid \"env DISPLAY=hplnpm:0.0 /usr/local/bin/x11emacs \" &"))
  142.           (3 (system "xhost hplhcid ; remsh hplhcid \"env DISPLAY=hplnpm:0.0 /usr/local/bin/X11/xmh \" &"))
  143.           (4 (system (strcat
  144.               "xhost hplhcid ; remsh hplhcid \"env DISPLAY=hplnpm:0.0 /usr/local/emacs/bin300/gnuclient "
  145.               (send edit_w :get_string)
  146.               " &")))
  147.           (T (system "Error\n")))
  148.     ))
  149.  
  150. (setq hplptd_pd_w
  151.       (send XM_ROW_COLUMN_WIDGET_CLASS :new :simple_pulldown_menu
  152.         "pulldown" menubar_w
  153.         :XMN_POST_FROM_BUTTON 2    ;post pulldown from menubar's second button.
  154.         :XMN_BUTTON_COUNT 5        ;create five buttons in this pulldown
  155.         :XMN_BUTTONS           #("xterm" "hpterm" "emacs" "xmh" "edit file in editor")
  156.         :XMN_BUTTON_MNEMONICS       #(#\x     #\h      #\e     #\m    #\e)
  157. ;;;        :XMN_BUTTON_ACCELERATORS       #("Ctrl<Key>C" "Ctrl<Key>F" "Ctrl<Key>O" "Ctrl<Key>S" "Ctrl<Key>W")
  158. ;;;        :XMN_BUTTON_ACCELERATOR_TEXT #("^C" "^F" "^O" "^S" "^W")
  159.         ))
  160. (send hplptd_pd_w
  161.       :add_callback :xmn_entry_callback    ;use this instead of XmNsimpleCallback
  162.       '(CALLBACK_ENTRY_WIDGET)
  163.       '(
  164.     ;; (send CALLBACK_ENTRY_WIDGET :name) returns "button_<#>"
  165.     ;; where <#> is 0 ... (button-count-1).
  166.     ;; we use 'read' to return the FIXNUM <#> after truncating the
  167.     ;; 7 chars "button_" from the front of the string.
  168.     (case (read (make-string-input-stream (send CALLBACK_ENTRY_WIDGET :name) 7))
  169.           (0 (system "xhost hplptd ; remsh hplptd \"env DISPLAY=hplnpm:0.0 /usr/bin/X11/xterm \" &"))
  170.           (1 (system "xhost hplptd ; remsh hplptd \"env DISPLAY=hplnpm:0.0 /usr/bin/X11/hpterm \" &"))
  171.           (2 (system "xhost hplptd ; remsh hplptd \"env DISPLAY=hplnpm:0.0 /usr/local/bin/x11emacs \" &"))
  172.           (3 (system "xhost hplptd ; remsh hplptd \"env DISPLAY=hplnpm:0.0 /usr/local/bin/X11/xmh \" &"))
  173.           (4 (system (strcat
  174.               "xhost hplptd ; remsh hplptd \"env DISPLAY=hplnpm:0.0 /usr/local/emacs/bin300/gnuclient "
  175.               (send edit_w :get_string)
  176.               " &")))
  177.           (T (system "Error\n")))
  178.     ))
  179.  
  180. (send toplevel_w :realize)
  181.  
  182. )
  183.